home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_asm / disasm / apendtxt.bas next >
BASIC Source File  |  1988-06-03  |  5KB  |  118 lines
  1. 1000 '*************************************************************************
  2. 1010 '*************************************************************************
  3. 1020 '
  4. 1030 'APPEND,  Version 1.0
  5. 1040 'Author:  J. Crone
  6. 1050 'Date:    1-25-82
  7. 1060 '
  8. 1070 'Copyright 1982 by Personal Computer Age.  All rights reserved.
  9. 1080 'This program is published for the personal use of readers of Personal
  10. 1090 'Compurter Age.  Commercial use is prohibited.
  11. 1100 '
  12. 1110 '*************************************************************************
  13. 1120 '*************************************************************************
  14. 1130 '
  15. 1140 '
  16. 1150 'Initialize.
  17. 1160 DEFINT A-Z:KEY OFF:CLS
  18. 1170 CLOSE 'any oper files.
  19. 1180 'Set the following variable equal to a number slightly larger than
  20. 1190 'the length of the average line in the files you will be appending.
  21. 1200 AVG.LINE.LEN=140
  22. 1210 ARRAY.SIZE = FRE(0)/(AVG.LINE.LEN + 1)
  23. 1220 DIM TRANSFER$(ARRAY.SIZE)
  24. 1230 '
  25. 1240 '
  26. 1250 'Display title and instructins.
  27. 1260 DATA "   PERSONAL COMPUTER AGE - File Combining Utility   "
  28. 1270 DATA "Enter file names as requested.  An output file is required"
  29. 1280 DATA "and may be a new file or an existing file.  Up to eight"
  30. 1290 DATA "append files may be entered.  After completion the output"
  31. 1300 DATA "file will contain all files in the order listed.  Type"
  32. 1310 DATA "'\' as the last entry to start execution."
  33. 1320 DATA "Note: this utility works on text files only."
  34. 1330 COLOR 0,7:READ TEXT$:LOCATE 3,(40-(LEN(TEXT$)/2)):PRINT TEXT$:COLOR 7,0
  35. 1340 COL = 10:FOR I = 5 TO 9:LOCATE I,COL:READ TEXT$:PRINT TEXT$:NEXT I
  36. 1345 PRINT:PRINT:LOCATE ,COL:READ TEXT$:PRINT TEXT$
  37. 1350 '
  38. 1360 '
  39. 1370 LOCATE 25,25:COLOR 8,1:INPUT "Press Return Key to continue!",I$:COLOR 0,1
  40. 1380 'Get output file name.
  41. 1390 ON ERROR GOTO 1920
  42. 1400 I = 1
  43. 1410 CLS:LOCATE 3,31:COLOR 8,1:PRINT "Diskette Directory"
  44. 1420 PRINT:PRINT:FILES:COLOR 0,1
  45. 1430 COL=25:LOCATE 13,COL:LINE INPUT; "Output File Name    - ",FILE.NAME$(I)
  46. 1440 IF INSTR(FILE.NAME$(I),"\") THEN GOTO 1830 'Abort.
  47. 1450 OPEN FILE.NAME$(I) FOR APPEND AS #1
  48. 1460 '
  49. 1470 '
  50. 1480 'Get append file names.
  51. 1490 FOR I = 2 TO 9
  52. 1500 LOCATE 25,1:PRINT SPC(79)
  53. 1510 LOCATE 12 + I,COL: PRINT USING "Append File Name  _## - ";(I-1);
  54. 1520 LINE INPUT FILE.NAME$(I)
  55. 1530 IF INSTR(FILE.NAME$(I),"\") THEN GOTO 1610 'done.
  56. 1540 'Test for good file specification.
  57. 1550 OPEN FILE.NAME$(I) FOR INPUT AS #2:CLOSE #2
  58. 1560 NEXT I
  59. 1570 IF I = 10 THEN I = 9
  60. 1580 ON ERROR GOTO 0
  61. 1590 '
  62. 1600 '
  63. 1610 'Do the job.
  64. 1620 LOCATE 25,1:PRINT SPC(79)
  65. 1630 FOR J = 2 TO (I-1)
  66. 1640 LOCATE 25,1:PRINT SPC(79);
  67. 1650 COLOR 23,0:LOCATE 25.25:PRINT "Appending ",FILE.NAME$(J);:COLOR 7,0
  68. 1660 OPEN FILE.NAME$(J) FOR INPUT AS #2
  69. 1670 ERASE TRANSFER$ 'Garbage collection, the fast way.
  70. 1680 DIM TRANSFER$(ARRAY.SIZE)
  71. 1690 FOR K = 0 TO ARRAY.SIZE 'Read lines from input file.
  72. 1700 IF EOF(2) THEN GOTO 1730
  73. 1710 LINE INPUT #2,TRANSFER$(K)
  74. 1720 NEXT K
  75. 1730 IF K = 0 THEN GOTO 1780
  76. 1740 FOR L = 0 TO (K-1) 'Write lines to output file.
  77. 1750 PRINT #1, TRANSFER$(L)
  78. 1760 NEXT L
  79. 1770 GOTO 1670
  80. 1780 CLOSE #2 'Input file.
  81. 1790 NEXT J
  82. 1800 CLOSE #1 'Output file.
  83. 1810 '
  84. 1820 '
  85. 1830 'More work to do?
  86. 1840 LOCATE 25,1:PRINT SPC(79);:LOCATE 24,15
  87. 1850 LINE INPUT; "Job Complete.  More files to transfer? (Y/N) ";RESPONSE$
  88. 1860 IF LEFT$(RESPONSE$,1) = "Y" OR LEFT$(RESPONSE$,1) = "y" THEN GOTO 1890
  89. 1870 CLS:SYSTEM 'system 'Job complete, return to DOS.
  90. 1880 'Erase screen and go again.
  91. 1890 FOR I = 11 TO 25: LOCATE I,1:PRINT SPC(78);: NEXT I
  92. 1900 GOTO 1380
  93. 1910 '
  94. 1920 'Trap common errors.
  95. 1930 BEEP
  96. 1940 MSG52$ = "Too many files open, Allocate more buffers and try again."
  97. 1950 MSG53$ = "That file does not exist.  Please reenter."
  98. 1960 MSG64$ = "Incorrect file specification.  Please reenter."
  99. 1970 MSG67$ = "Bad file name or too many files.  Reenter or use a new disk."
  100. 1980 MSG70$ = "Remove write protect tab from disk."
  101. 1990 MSG71$ = "Put a disk in the drive and close the door."
  102. 2000 LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1
  103. 2010 TRAP = 0
  104. 2020 IF ERR = 52 THEN PRINT MSG52$;:CLOSE: END
  105. 2030 IF ERR = 53 THEN PRINT MSG53$;: TRAP = 1
  106. 2040 IF ERR = 64 THEN PRINT MSG54$;: TRAP = 1
  107. 2050 IF ERR = 67 THEN PRINT MSG67$;: TRAP = 1
  108. 2060 IF ERR = 70 THEN PRINT MSG70$;: TRAP = 1
  109. 2070 IF ERR = 71 THEN PRINT MSG71$;: TRAP = 1
  110. 2080 IF TRAP = 0 THEN GOTO 2120
  111. 2090 'Found the problem.  Go back and try again.
  112. 2100 LOCATE 12 + I,1:PRINT SPC(79);
  113. 2110 IF I = 1 THEN RESUME 1430 ELSE RESUME 1510
  114. 2120 'Not a common error. Let the system handle it.
  115. 2130 ON ERROR GOTO 0:CLOSE
  116. 2140 SAV.ERR = ERR:RESUME 2150
  117. 2150 ERROR SAV.ERR:END
  118.